perm filename TRANSO.BBN[1,LMM] blob
sn#029042 filedate 1973-03-11 generic text, type T, neo UTF8
(PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")
T)
(LISPXPRIN1 (QUOTE "24-DEC-72 15:37:14")
T)
(LISPXTERPRI T))
(DEFINEQ
(TRANSOR
[LAMBDA (SOURCEFILE)
(PROG (INPUTFILE OUTPUTFILE LISTFILE LISTING NAMEFIELD EXPRESSION
TMP (OB (GETBRK))
(OS (GETSEPR)))
(SETBRK (QUOTE (93 91 41 40 34)))
(SETSEPR (QUOTE (32 31 13 10)))
(COND
((NLISTP (CAR (QUOTE TRANSFORMATIONS)))
(ERROR (QUOTE "NO TRANSFORMATIONS LOADED")
(QUOTE π)
T))
((NULL (SETQ INPUTFILE (INFILEP SOURCEFILE)))
(ERROR (QUOTE "CANNOT FIND FILE:")
SOURCEFILE T)))
[SETQ NAMEFIELD (SUBSTRING INPUTFILE
(ADD1 (OR (STRPOS (QUOTE >)
INPUTFILE)
0))
(SUB1 (STRPOS (QUOTE %.)
INPUTFILE]
(COND
([NULL (SETQ OUTPUTFILE
(OUTFILEP (SETQ TMP (MKATOM (CONCAT NAMEFIELD
(QUOTE ".TRAN"]
(ERROR (QUOTE "CANNOT OPEN FILE")
TMP T))
([NULL (SETQ LISTFILE (OUTFILEP
(SETQ TMP (MKATOM (CONCAT NAMEFIELD
(QUOTE ".LSTRAN"]
(ERROR (QUOTE "CANNOT OPEN FILE")
TMP T))) (* All the preliminary
error checks ok.
Open files, print
headers.)
(INPUT (INFILE INPUTFILE))
(SETQ TMP (OUTFILE OUTPUTFILE))
(OUTFILE LISTFILE)
(OUTPUT TMP)
(PRIN1 (QUOTE "(PRIN1(QUOTE %"
TRANSORING OF ")
OUTPUTFILE)
(PRINT INPUTFILE OUTPUTFILE)
(PRIN1 (QUOTE " DONE ON ")
OUTPUTFILE)
(PRIN1 (DATE)
OUTPUTFILE)
(PRIN1 (QUOTE " %")T)")
OUTPUTFILE)
(TERPRI OUTPUTFILE)
(TERPRI OUTPUTFILE)
(PRIN1 (QUOTE " LISTING FROM TRANSORING OF FILE ")
LISTFILE)
(PRINT INPUTFILE LISTFILE)
(PRIN1 (QUOTE " DONE ON ")
LISTFILE)
(PRIN1 (DATE)
LISTFILE)
(TERPRI LISTFILE)
(TERPRI LISTFILE)
LP (COND
([NULL (NLSETQ (PROG (HELPCLOCK)
(* Rebind HELPCLOCK so that when over-read EOF no
error message or BREAK will occur.)
(SETQ EXPRESSION (UREAD INPUTFILE]
(GO DONE)))
[SELECTQ EXPRESSION
(STOP
(* Only check for STOP, no check for NIL.
Foreign files never have STOPs on them and rarely
have extra parens or NIL's.
Extra NIL's on a file usually indicate that the
reading machinery is screwed up, probably because
user forgot to perform (ESCAPE), or, even worse,
there is a different ESCAPE character.
I therefore must ERRORSET protect the UREAD above
anyway, and try to keep reading until can read no
further.)
(GO DONE))
(COND
((NLISTP EXPRESSION)
(TRANSERR NIL
"NLISTP EXPRESSION ON FILE - EXPRESSION DISCARDED"
(EXPRESSION))
(GO LP]
(SETQ EXPRESSION (TRANSFORM EXPRESSION))
(TRANSOUT EXPRESSION OUTPUTFILE)
(GO LP)
DONE(AND (OPENP INPUTFILE)
(CLOSEF INPUTFILE))
(ENDFILE OUTPUTFILE)
(TRANSLIST LISTING LISTFILE)
(CLOSEF LISTFILE)
(SETBRK OB)
(SETSEPR OS)
(RETURN (LIST OUTPUTFILE LISTFILE])
(TRANSORFORM
[LAMBDA (FORM)
(PROG (LISTFILE LISTING)
(SETQ FORM (TRANSFORM FORM))
(AND LISTING (ERSETQ (TRANSLIST LISTING)))
(* ERRORSET so user can
abort with ↑E,
especially when used in
TXTEST.)
(RETURN FORM])
(TRANSORFNS
[LAMBDA (FNLIST)
(PROG (LISTING LISTFILE DEF)
[MAPC FNLIST (FUNCTION (LAMBDA (FN)
(COND
([AND (LITATOM FN)
(EXPRP (SETQ DEF (VIRGINFN FN]
(TRANSFORM DEF FN))
(T (PRINT (CONS FN (QUOTE (NOT FOUND)))
T]
(ERSETQ (TRANSLIST LISTING))
(RETURN FNLIST])
(TRANSFORM
[LAMBDA (SOURCEXPR FNAME)
(* TRANSFORM is the entry to the translator.
It returns the translated SOURCEXPR, and resets
LISTING and uses LISTFILE freely
(see KEEPLIST). -
The source expression is embedded one level so that
top-level embeds will work
(i.e. the case where the source expression is
(FOO --) and the transformation for FOO is MBD). -
FNAME is provided only by TRANSORFNS.
Thus if not provided, SOURCEXPR is a FORM from
TRANSORFORM or TRANSOR's file, and we begin
translation at SOURCEXPR, but if FNAME is given,
SOURCEXPR is a LAMBDA expression and we do a 3
command first, to get to a FORM.
-
RETAIL also checks this top-level expression.
If the top level is (NIL &) it is of no interest to
user. But if FNAME was given, top level is
(FNAME &) and should be printed, otherwise user will
see only a LAMBDA expression and not know where it
came from.)
(PROG (L PASS1 HELPCLOCK)
[COND
[FNAME (SETQ L (LIST (CADDR SOURCEXPR)
SOURCEXPR
(LIST FNAME SOURCEXPR]
(T (SETQ L (LIST SOURCEXPR (LIST NIL SOURCEXPR]
(WACHADOON T)
(PROCEED TRANSFORM)
(MAPC (DREVERSE PASS1)
(FUNCTION PPASS1))
(RETURN (COND
(FNAME (CADR L))
(T (CAR L])
(PROCEED
[NLAMBDA (FLG)
(PROG ((L L)
STOPPEDUP WHERETOGONEXT CONTINUEL CONTINUETAIL TRANSITL
TRANSITAIL OLDLENGTH)
LP (COND
([ERSETQ
(SETQ L
(EDITL
L
(SELECTQ
FLG
[DOTHIS (QUOTE ((IF (TAILP (CAR L)
(CADR L))
((REMARK TAILP/DOTHIS)
1)
NIL)
MARK
(ORR (NX UP (S STOPPEDUP))
(!NX UP (S STOPPEDUP))
NIL)←←(LPQ (COMS (TRANSIT)
(TRANXT]
[DOTHESE
(QUOTE
(MARK
(ORR
([IF (NOT (TAILP (CAR L)
(CADR L]
NX UP (S STOPPEDUP))
(!NX UP (S STOPPEDUP))
NIL)←←
1
(LPQ (COMS (TRANSIT)
(TRANXT]
[TRANSFORM (QUOTE ((LPQ (COMS (TRANSIT)
(TRANXT]
[OKCOMS (QUOTE ((LPQ (COMS (TRANXT)
(TRANSIT]
(HELP]
(SETQ FLG (QUOTE OKCOMS))
(GO LP))
(T (TRANSERR TRANSERROR
"FAIL RETURN FROM EDITOR. SHOW JIM GOODWIN."
(CURRENTFORM CURRENTCOMS])
(TRANSIT
[LAMBDA NIL
(PROG ((HERE (CAR L))
TMP)
(WACHADOON)
[COND
((TAILP HERE (CADR L))
(TRANSERR TRANSERROR
"TAILP AT TRANSIT. SHOW JIM GOODWIN."
(CURRENTFORM CURRENTCOMS))
(SETQ L (CONS (SETQ HERE (CAR HERE))
(CDR L]
(SETQ CURRENTFORM HERE)
(SETQ CONTINUEL)
[SETQ WHERETOGONEXT (QUOTE (ORR 2 NX !NX ((E (TRANSEXIT]
(* The call to TRANSEXIT above causes the exits from
PROCEED which occur because of dropoff.)
(SETQ OLDLENGTH (LENGTH (CADR L)))
(SETQ TRANSITL L)
[COND
((AND LASTAIL (EQ (CAR LASTAIL)
HERE))
(SETQ TRANSITAIL LASTAIL))
((OR [NULL (SETQ TRANSITAIL (MEMB HERE (CADR L]
(MEMB HERE (CDR TRANSITAIL)))
(HELP (QUOTE "LASTAIL UNAVAILABLE - LOCATION UNCERTAIN")
(QUOTE π]
[SETQ CURRENTCOMS (COND
([AND STOPPEDUP (EQ HERE (CAR STOPPEDUP))
(OR (LISTP HERE)
(EQ STOPPEDUP (## UP] (* Exit on match with
STOPPEDUP.)
(RETFROM (QUOTE PROCEED)))
((NLISTP HERE)
NLISTPCOMS)
((LITATOM (CAR HERE))
(* If user commands cause an error it will be
trapped by the ORR and XFORMER will be executed.
XFORMER is a TRANSORMACRO which makes a remark on
the error. Don't make the list if no commands.)
(GETP (CAR HERE)
(QUOTE XFORM)))
((LISTP (CAR HERE))
LAMBDACOMS)
(T (QUOTE ((COMSQ (REMARK ILLCAR)
DOTHESE]
(RETURN (COND
(CURRENTCOMS (FRPLACA (CDR TRANSITCONSES)
CURRENTCOMS)
(* If CURRENTCOMS is NIL, return NIL;
otherwise effectively embed CURRENTCOMS in orr such
that if CURRENTCOMS fail, xformer will be executed.
Xformer is a transormacro which calls TRANSERR
appropriately for a faulty transformation.)
TRANSITCONSES])
(TRANXT
[LAMBDA NIL
(PROG (NEWFORM NEWLENGTH TMP NEWTAIL)
(COND
(CONTINUEL (SETQ L CONTINUEL)
(SETQ LASTAIL CONTINUETAIL)
(RETURN)))
(SETQ NEWFORM (CAR TRANSITAIL))
(SETQ NEWLENGTH (LENGTH (CADR TRANSITL)))
(COND
((NEQ NEWLENGTH OLDLENGTH)
(GO DELETED))
((OR (EQ NEWFORM CURRENTFORM)
(EQ WHERETOGONEXT (QUOTE NLAMIT)))
(* If containing list still points at same EQ
structure, or if he's declared he's done with
whatever is there, no problem.)
)
((AND (LISTP NEWFORM)
(EDITFINDP NEWFORM (SETQ TMP (CONS (QUOTE ==)
CURRENTFORM))
T))
(* Net effect was an MBD. If we went on from here in
normal fashion, we would embed it again and again.
Find original expression and go on from there.)
(SETQ WHERETOGONEXT (CONS TMP WHERETOGONEXT)))
((AND (LISTP CURRENTFORM)
(EDITFINDP CURRENTFORM (CONS (QUOTE ==)
NEWFORM)
T))
(* Net effect was XTR. If we went on normally, we'd
miss the form extracted. Set continuation commands
to NIL so we stay where we are)
(SETQ WHERETOGONEXT))
(T
(* User did a : or DELETE where effect was
(: NIL). Assume the stuff he put in place of old
does not need translation. perform NLAM for him.)
(SETQQ WHERETOGONEXT NLAM)))
(* Ready to return. Fix up L, smashing CAR to point
to right thing. In normal case,
(EQ CURRENTFORM NEWFORM), it already does and this
FRPLACA is a NOP.)
ZIPPO
(SETQ L (FRPLACA TRANSITL NEWFORM))
(SETQ LASTAIL TRANSITAIL) (* Finally, return the
commands which will
locate the next form to
translate.)
(RETURN WHERETOGONEXT)
DELETED
(COND
((NEQ (SUB1 OLDLENGTH)
NEWLENGTH)
(* This could happen if user cheated by doing a !0
and deleting several things or inserting things.)
(TRANSERR OUTOFBOUNDS
"TRANSFORMATION CHANGED SOMETHING OUT OF BOUNDS"
(CURRENTFORM CURRENTCOMS)))
[(NOT (TAILP TRANSITAIL (CADR L)))
(* User deleted the form, but it was the last form
on its containing list.)
(RETURN (QUOTE (ORR !NX ((E (TRANSEXIT]
(T
(* User deleted the form, but was not last thing,
thus NEWFORM is already bound to the NX thing after
the one we just 'translated' by deleting it.
Set WHERETOGONEXT to NIL so we do not move at all.)
(SETQ WHERETOGONEXT)
(GO ZIPPO])
(TRANSEXIT
[LAMBDA NIL
[COND
(STOPPEDUP (TRANSERR TRANSERROR
"MISSED TRANSEXIT. SHOW JIM GOODWIN."
(CURRENTFORM CURRENTCOMS]
(RETFROM (QUOTE PROCEED])
(KEEPLIST
[NLAMBDA (REMNAME)
(PROG (TMP)
[COND
((NLISTP LISTING) (* Initialize if first
remark in this LISTING.)
(SETQ LISTING (LIST 1)))
(T (FRPLACA LISTING (ADD1 (CAR LISTING]
(SETQ PASS1 (CONS (CONS (CAR LISTING)
(CONS REMNAME L))
PASS1)) (* Save pass2 stuff for
TRANSLIST.)
[COND
(TESTRAN (* Skip pass2 if
testing)
NIL)
[[NULL (SETQ TMP (FASSOC REMNAME (CDR LISTING]
(* First use of this
remark.)
(NCONC1 LISTING (LIST REMNAME (CAR LISTING]
(T (NCONC1 TMP (CAR LISTING]
(RETURN])
(TRANSERR
[NLAMBDA (REM MESS VARS)
(AND REM (APPLY (FUNCTION KEEPLIST)
(LIST REM)))
[AND MESS (NLSETQ (PROGN (TERPRI T)
(TERPRI T)
(PRIN1 (QUOTE "
TRANSLATION ERROR: ")
T)
(PRIN1 MESS T)
(TERPRI T]
(AND VARS (NLSETQ (PROGN (PRINTLEVEL 3)
[MAPC VARS (FUNCTION (LAMBDA (X)
(PRIN2 X T)
(PRIN1 (QUOTE ": ")
T)
(PRINT (EVALV X]
(PRINTLEVEL 1000)
(TERPRI T])
(TRANSOUT
[LAMBDA (XPR FILE)
(PROG (OLDO)
(* XPR is a transored form which is to be put on the
output file.)
(AND (EQ FILE (QUOTE NIL:))
(RETURN))
(SETQ OLDO (OUTPUT FILE))
(COND
((NEQ (QUOTE DEFINEQ)
(CAR XPR))
(TERPRI)
(PRINTDEF XPR)
(TERPRI))
(T (* Special formatting
for function lists.)
(PRIN1 (QUOTE "(DEFINEQ"))
(TERPRI)
[MAPC (CDR XPR)
(FUNCTION (LAMBDA (X)
(TERPRI)
(PRIN1 (QUOTE %())
(PRINT (CAR X))
(PRINTDEF (CADR X))
(PRIN1 (QUOTE %)))
(TERPRI]
(PRIN1 (QUOTE %)))
(TERPRI)))
(OUTPUT OLDO)
(RETURN])
(PPASS1
[LAMBDA (P1)
(PRIN1 (CAR P1)
LISTFILE)
(PRIN1 (QUOTE ". ")
LISTFILE)
(PRIN1 (CADR P1)
LISTFILE)
(PRIN1 (QUOTE " at ")
LISTFILE)
(PRECH (CDDR P1)
NIL LISTFILE T)
(TERPRI LISTFILE])
(TRANSLIST
[LAMBDA (LISTING LISTFILE) (* TRANSLIST must dump
the second half of the
listing prettily.)
(PROG (OLDO)
(COND
(TESTRAN (* See TXTEST.)
(RETURN))
((EQ LISTFILE (QUOTE NIL:))
(RETURN)))
(SETQ OLDO (OUTPUT LISTFILE)) (* See KEEPLIST for
discussion of format of
LISTING.)
[COND
[(NULL LISTING)
(* User would like to know if this happens rather
than just wondering where his output went.)
(PRINT (QUOTE (NO REMARKS -- EMPTY LISTING]
(T (PRIN1 (QUOTE
" INDEX OF REMARKS
"))
(MAPC (SORT (CDR LISTING)
T)
(FUNCTION TRANSLIST1]
(TERPRI)
(OUTPUT OLDO)
(RETURN])
(TRANSLIST1
[LAMBDA (L1)
(PRIN1 (CAR L1)) (* Name of remark.)
(PRIN1 (QUOTE " at "))
(MAPRINT (CDR L1)
NIL NIL (QUOTE ".
")
(QUOTE ", "))
(PREMTEXT (CAR L1))
(TERPRI])
(PREMTEXT
[LAMBDA (RNAM)
(PROG (TXT)
[COND
((OR (SETQ TXT (ASSOC RNAM USERNOTES))
(SETQ TXT (ASSOC RNAM TRANSOREMARKS)))
(SETQ TXT (CADR TXT)))
(T (SETQQ TXT (* The text of this
remark was not defined
in the TRANSFORMATIONS
file.)]
(SPACES 5)
[COND
((EQ (CADR TXT)
(QUOTE %%))
(* Lower-case the comment before using it, if he is
testing and it hasn't been dumped before.)
(RPLACD TXT (COMMENT3 (CDDR TXT)
NIL T]
(MAPRINT (CDR TXT))
(TERPRI])
(WACHADOON
[LAMBDA (FLG)
(OR TESTRAN (PROG ((NOW (CLOCK)))
(COND
(FLG (SETQ WACHADID)
(SETQ WHENTODOIT NOW)
(RETURN))
((ILESSP NOW WHENTODOIT)
(RETURN)))
(PRECH L WACHADID T)
(SETQ WACHADID L)
(SETQ WHENTODOIT (IPLUS 180000 NOW])
(PRECH
[LAMBDA (ECH OLDECH FILE PRTYFLG) (* Function to Print a
Reversed Edit CHain in
my special format.)
(PROG ((OLDO (OUTPUT FILE))
X)
[SETQ X (PRECH1 (RETAIL (COND
(OLDECH (LNC ECH OLDECH))
(T ECH]
(COND
(PRTYFLG (PRINTDEF X))
(T (PRINT X)))
(TERPRI)
(OUTPUT OLDO)
(RETURN])
(PRECH1
[LAMBDA (RECH)
(PROG (LASTALE (N -2)
LST)
[COND
((NULL (CDR RECH))
(RETURN (MKSTRING (PRECH2 (CAR RECH)
4]
[SETQ LASTALE (SOME (CAR RECH)
(FUNCTION (LAMBDA (E)
(ADD1VAR N)
(EQ E (CADR RECH]
(AND (MINUSP N)
(GO OUT))
(SETQ LST (CONS (COND
((NLISTP (CAAR RECH))
(CAAR RECH))
(T (PRECH2 (CAAR RECH)
3)))
LST))
(SELECTQ N
(0)
(1 (SETQ LST (CONS (COND
((NLISTP (CADAR RECH))
(CADAR RECH))
(T (QUOTE &)))
LST)))
(SETQ LST (CONS (MKATOM (CONCAT (QUOTE ...)
N
(QUOTE ...)))
LST)))
OUT (SETQ LST (CONS (PRECH1 (CDR RECH))
LST))
[COND
((CDR LASTALE)
(SETQ LST (CONS (QUOTE --)
LST]
(RETURN (DREVERSE LST])
(PRECH2
[LAMBDA (X LEVEL)
(COND
((NLISTP X)
X)
((EQ (CAR X)
(QUOTE *))
(QUOTE "**COMMENT**"))
((ILESSP LEVEL 1)
(QUOTE &))
(T (MAPCAR X [FUNCTION (LAMBDA (XELT)
(SUB1VAR LEVEL)
(COND
((MINUSP LEVEL)
(QUOTE --))
(T (PRECH2 XELT LEVEL]
(FUNCTION (LAMBDA (TAIL)
(* At last!!!! I get to use the second functional
argument to a mapping function.
To implement a triangular PRINTLEVEL, step the LEVEL
down in the first function and select hyphens when
it hits bottom; cut off the rest of the MAP by
checking for bottom here.)
(AND (NULL (MINUSP LEVEL))
(CDR TAIL])
(RETAIL
[LAMBDA (L)
(PROG (RES)
[SETQ RES (LIST (COND
((TAILP (CAR L)
(CADR L))
(CAAR L))
(T (CAR L]
[MAP (CDR L)
(FUNCTION (LAMBDA (TAIL)
(COND
[(NULL (CDR TAIL))
(* At end. If top-most expression is
(NIL &) don't include it. Otherwise is from
TRANSORFNS, so include it. See TRANSFORM.)
(AND (CAAR TAIL)
(SETQ RES (CONS (CAR TAIL)
RES]
((MEMB (CAR TAIL)
(CADR TAIL))
(* If not a TAIL, must be MEMB, otherwise edit chain
screwed up. We want every one that's MEMB.)
(SETQ RES (CONS (CAR TAIL)
RES]
(RETURN RES])
(LNC
[LAMBDA (L1 L2)
(* LNC is for Last New Cons.
Returns last tail of L1 such that it is not common
with L2. L1 is the edit chain representing TRANSOR's
current location; L2 is the chain from the last call
to WACHADOON. Value is (LAST L1) if nothing in
common, i.e. we are transoring an entirely different
source expression.)
(PROG (X)
(COND
((NLISTP L1)
(HELP))
((NEQ (SETQ X (LAST L1))
(LAST L2))
(* Quick check for commonest case, we are in a
totally different source expression.)
(RETURN X)))
LP (COND
((TAILP (CDR L1)
L2)
(RETURN L1)))
(SETQ L1 (CDR L1))
(GO LP])
(PRESCAN
[LAMBDA (FILE CHARLST PRESCANFN)
(* PRESCAN is for pre-digesting files from alien
environments where special characters, etc., are all
different. -
FILE is input file; output goes to next higher
version. -
CHARLST is list of dot-pairs of character codes
(old . new), so that you can for example replace all
tabs in a file with spaces by including
(9 . 32) on CHARLST. -
PRESCANFN is function for user.
If the new character code for any character is NIL,
then PRESCANFN is called giving the character code
as its first argument. PRESCANFN can then do what it
needs to process the upcoming file information.
The second argument to PRESCANFN is the input file,
and the third is the output file.
-
Original impetus for this was MIT Lisp's special
recognition of semicolon: any line beginning with
semicolon was comment, a la macro files.
With (59) on CHARLST, where 59 is character code for
semicolon, PRESCANFN can process those lines, making
them into regular comments.
Note that no output is done for these special
characters unless PRESCANFN does it.)
(PROG ((INF (INPUT (INFILE FILE)))
[OUTF (OUTPUT (OUTFILE (NAMEFIELD FILE T]
(I 127))
TOP (COND
((NOT (ZEROP I))
(SETA PRESCARRAY I I)
(SUB1VAR I)
(GO TOP)))
[MAPC CHARLST (FUNCTION (LAMBDA (PR)
(SETA PRESCARRAY (CAR PR)
(OR (CDR PR)
0]
(ASSEMBLE NIL
(CQ INF)
(FASTCALL IFSET)
(HRRZ 1 , FILEN (3))
(PUSHN)
(VAR (HRRZ 2 , OUTF))
(FASTCALL OFSET)
(HRRZ 1 , FILEN (3))
(PUSHN)
ENTRY
(CQ PRESCARRAY)
(SKIPA 4 , * 1)
(XWD 2 1)
(ADD 4 , 1)
(* Ac4 now has PRESCARRAY<2> , i.e. indirect ref
thru 4 will get NTH ELT of PRESCARRAY, where n is in
ac2.)
LOOP(MOVE 1 , -1 (NP))
(JSYS 40) (* BIN)
(JUMPE 2 , DONE)
(SKIPG 0 , @ 4)
(JRST SPECIAL)
(MOVE 2 , @ 4)
LOUT(MOVE 1 , 0 (NP))
(JSYS 41) (* BOUT)
(JRST LOOP)
DONE(JSYS 20) (* GTSTS)
(TLNE 2 , 512)
(JRST DONE!)
(SETZ 2 ,)
(JRST LOUT)
SPECIAL
(MOVE 1 , 2)
(CQ (SETQ I (LOC (AC)))
(APPLY* PRESCANFN I INF OUTF))
(JRST ENTRY)
DONE!)
(CLOSEF INF)
(RETURN (CLOSEF OUTF])
)
(LISPXPRINT (QUOTE TRANSORFNS)
T)
(RPAQQ TRANSORFNS
(TRANSOR TRANSORFORM TRANSORFNS TRANSFORM PROCEED TRANSIT
TRANXT TRANSEXIT KEEPLIST TRANSERR TRANSOUT PPASS1
TRANSLIST TRANSLIST1 PREMTEXT WACHADOON PRECH PRECH1
PRECH2 RETAIL LNC PRESCAN))
(LISPXPRINT (QUOTE TRANSORVARS)
T)
(RPAQQ TRANSORVARS
(TRANSORMACROS TRANSOREMARKS
(VARS (MAXLOOP 1530)
(TESTRAN)
(USERMACROS (APPEND TRANSORMACROS
USERMACROS))
(EDITCOMSA (UNION (QUOTE (NLAM NLAMIT
DOTHESE
DOTHIS
XFORMER
CONTINUE))
EDITCOMSA))
(EDITCOMSL (UNION (QUOTE (REMARK))
EDITCOMSL))
(TRANSITCONSES (QUOTE (ORR NIL XFORMER)))
(PRESCARRAY (ARRAY 127 127)))
(PROP BLKLIBRARYDEF TAILP GETP)
(BLOCKS * TRANSORBLOCKS)))
[RPAQQ TRANSORMACROS ((REMARK (TXT)
(E (KEEPLIST TXT)
T))
(NLAM NIL (E (SETQQ WHERETOGONEXT NLAMIT)
T))
[NLAMIT NIL (ORR NX !NX ((E (TRANSEXIT]
(DOTHESE NIL (E (PROCEED DOTHESE)
T)
NLAM)
(DOTHIS NIL (E (PROCEED DOTHIS)
T)
NLAM)
(XFORMER NIL (E (TRANSERR TRANSFORMATIONERROR
"FAULTY TRANSFORMATION"
(CURRENTFORM CURRENTCOMS))
T]
[RPAQQ TRANSOREMARKS ((TRANSFORMATIONERROR (* The TRANSFORMATIONS
specified for this form
failed to work
properly. The TTY
message 'FAULTY
TRANSFORMATION' was
printed, any commands
remaining in the
transformation after
the erroneous one were
skipped, and
translation continued
as if the
transformation had been
normally completed. The
user should treat the
translated form with
caution and amend his
transformation to avoid
future problems.))
(TRANSERROR (* TRANSOR got confused at this point. The TTY
message 'SHOW JIM GOODWIN' was printed and
translation continued with the next form, but
the user should treat the compromised area of
code with caution.))
(BLAMBDA1 (* 55 NON-ATOMIC CAR OF FORM, NOT AN OPEN LAMBDA.
EITHER A PARENTHESIS ERROR OR COMPUTED CAR OF
FORM. COMPUTED CAR OF FORM IS NO LONGER LEGAL IN
BBN-LISP; APPLY* IS USED INSTEAD. IF COMPUTED
CAR OF FORM WAS INTENDED, THE TRANSLATION TO
APPLY* WILL RUN OK. SEE MANUAL FOR DISCUSSION OF
APPLY*.))
(BLAMBDA2 (* Open LAMBDA with wrong number of args. What can
it mean?))
(BLAMBDA3 (* Lambda-expression without forms. What can it
mean?))
(ILLCAR (* Illegal data-type encountered as CAR of form
Expression treated as list of forms.))
(TAILP/DOTHIS (* When the transormacro DOTHIS is executed at
a TAILP position, TRANSOR does a 1 command
first, assuming that the current position is
a list of forms and CAR of it is the form
intended. The user should make sure that
this is what was intended by the
TRANSFORMATIONS which called DOTHIS, i.e.
the TRANSFORMATIONS for the form containing
this one.]
(RPAQ MAXLOOP 1530)
(RPAQ TESTRAN)
(RPAQ USERMACROS (APPEND TRANSORMACROS USERMACROS))
(RPAQ EDITCOMSA (UNION (QUOTE (NLAM NLAMIT DOTHESE DOTHIS XFORMER
CONTINUE))
EDITCOMSA))
(RPAQ EDITCOMSL (UNION (QUOTE (REMARK))
EDITCOMSL))
(RPAQQ TRANSITCONSES (ORR NIL XFORMER))
(RPAQ PRESCARRAY (ARRAY 127 127))
(DEFLIST(QUOTE(
[TAILP (LAMBDA (X Y)
(* True if X is A tail of Y X and Y non-null.)
(* Included with editor for block compilation
purposes.)
(AND X (PROG NIL LP (COND ((NLISTP Y)
(RETURN NIL))
((EQ X Y)
(RETURN X)))
(SETQ Y (CDR Y))
(GO LP]
[GETP (LAMBDA (ATM PROP)
(AND (LITATOM ATM)
(PROG ((Z (CDR ATM)))
LOOP
[COND ((NLISTP Z)
(RETURN NIL))
((EQ (CAR Z)
PROP)
(RETURN (CADR Z]
(SETQ Z (CDDR Z))
(GO LOOP]
))(QUOTE BLKLIBRARYDEF))
[RPAQQ TRANSORBLOCKS ((PRECHBLOCK PRECH PRECH1 PRECH2 RETAIL LNC
(ENTRIES PRECH)
(BLKLIBRARY TAILP MEMB LAST LENGTH
ASSOC GETP))
(TRANSITBLOCK TRANSIT WACHADOON (ENTRIES TRANSIT WACHADOON)
(GLOBALVARS WACHADID WHENTODOIT TRANSITCONSES
LAMBDACOMS NLISTPCOMS)
(BLKLIBRARY TAILP MEMB LAST LENGTH ASSOC GETP))
(TRANXTBLOCK TRANXT (ENTRIES TRANXT)
(BLKLIBRARY TAILP MEMB LAST LENGTH ASSOC GETP]
(DECLARE
(BLOCK: PRECHBLOCK PRECH PRECH1 PRECH2 RETAIL LNC (ENTRIES PRECH)
(BLKLIBRARY TAILP MEMB LAST LENGTH ASSOC GETP))
(BLOCK: TRANSITBLOCK TRANSIT WACHADOON (ENTRIES TRANSIT WACHADOON)
(GLOBALVARS WACHADID WHENTODOIT TRANSITCONSES LAMBDACOMS
NLISTPCOMS)
(BLKLIBRARY TAILP MEMB LAST LENGTH ASSOC GETP))
(BLOCK: TRANXTBLOCK TRANXT (ENTRIES TRANXT)
(BLKLIBRARY TAILP MEMB LAST LENGTH ASSOC GETP))
)STOP